unit CAM;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Clipbrd, JPeg;

function capCreateCaptureWindow(lpszWindowName: LPCSTR; dwStyle: DWORD; x, y, nWidth, nHeight: integer; hwndParent: HWND; nID: integer): HWND; stdcall;
external 'AVICAP32.DLL' name 'capCreateCaptureWindowA';

procedure CreateCAMPanel(imgHandle: THandle; PHeight: integer; PWidth: integer; m_DeviceId: integer);
procedure CameraShot(Target: TBitmap);
procedure DisconnectCam();
procedure ConnectCam();

var
  CAMHandle: THandle;

implementation

uses
  uFrmMain, uFrmCameraGetImage;

const
  WM_CAP_START = WM_USER;

  WM_CAP_STOP = WM_CAP_START + 68;

  WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;

  WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;

  WM_CAP_SAVEDIB = WM_CAP_START + 25;

  WM_CAP_GRAB_FRAME = WM_CAP_START + 60;

  WM_CAP_SEQUENCE = WM_CAP_START + 62;

  WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;

  WM_CAP_SEQUENCE_NOFILE = WM_CAP_START + 63;
  WM_CAP_SET_VIDEOFORMAT = WM_CAP_START + 45;

  WM_CAP_SET_OVERLAY = WM_CAP_START + 51;

  WM_CAP_SET_PREVIEW = WM_CAP_START + 50;
  WM_CAP_GET_VIDEOFORMAT = WM_CAP_START + 44;

  WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6;

  WM_CAP_SET_CALLBACK_ERROR = WM_CAP_START + 2;

  WM_CAP_SET_CALLBACK_STATUSA = WM_CAP_START + 3;

  WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5;

  WM_CAP_SET_SCALE = WM_CAP_START + 53;

  WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;
  WM_CAP_DRIVER_GET_NAME = WM_CAP_START + 12;

  CameraDLL = 'AVICAP32.DLL';

var
  CAMBmp: TBitmap;
  hHeight, hWidth: integer;

procedure CreateCAMPanel(imgHandle: THandle; PHeight: integer; PWidth: integer; m_DeviceId: integer);
var
  handle: THandle;
  CAMTop, DeviceId: integer;
  CAMLeft: integer;
  Bt: BITMAPINFO;
begin
  CAMLeft := 0;
  CAMTop := 0;
  handle := capCreateCaptureWindow('Video', ws_child or ws_visible, CAMLeft, CAMTop, PWidth, PHeight, imgHandle, 1);
  if handle = 0 then
  begin
    Exit;
  end;
  DeviceId := 0;
  SendMessage(handle, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
  SendMessage(handle, WM_CAP_SET_CALLBACK_ERROR, 0, 0);
  SendMessage(handle, WM_CAP_SET_CALLBACK_STATUSA, 0, 0);
  while SendMessage(handle, WM_CAP_DRIVER_CONNECT, 0, DeviceId) = 0 do
  begin
    inc(DeviceId);
    if DeviceId > 3 then
    begin
      DestroyWindow(handle);
      Exit;
    end;
  end;
  hHeight := PHeight;
  hWidth := PWidth;
  CAMHandle := handle;
  SendMessage(handle, WM_CAP_GET_VIDEOFORMAT, SizeOf(Bt), LongInt(@Bt));
  Bt.bmiHeader.biWidth := hWidth;
  Bt.bmiHeader.biHeight := hHeight;
  Bt.bmiHeader.biSize := SizeOf(Bt.bmiHeader);
  Bt.bmiHeader.biPlanes := 1;
  Bt.bmiHeader.biBitCount := 24;
  SendMessage(handle, WM_CAP_SET_VIDEOFORMAT, SizeOf(Bt), LongInt(@Bt));
  SendMessage(handle, WM_CAP_SET_PREVIEWRATE, 33, 0);
  SendMessage(handle, WM_CAP_SET_PREVIEW, 1, 0);
end;

procedure DisconnectCam();
begin
  SendMessage(CAMHandle, WM_CAP_DRIVER_DISCONNECT, 0, 0);
end;

procedure ConnectCam();
begin
  SendMessage(CAMHandle, WM_CAP_DRIVER_CONNECT, 0, 0);
end;

procedure CameraShot(Target: TBitmap);
begin
  if CAMBmp = nil then
  begin
    CAMBmp := TBitmap.create;
    CAMBmp.height := hHeight;
    CAMBmp.width := hWidth;
  end;
  try
    BitBlt(CAMBmp.Canvas.handle, 0, 0, hWidth, hHeight, getDC(CAMHandle), 0, 0, SRCCOPY);
    Target.Assign(CAMBmp);
  finally
    ReleaseDC(0, CAMHandle);
  end;
end;

end.
